home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #102 (1990-12)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #102 (1990-12)(Amiga User Group Deutschland e.V.).adf / Raumgestaltung / Raumgestaltung_Drucken (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-07-03  |  9KB  |  366 lines
  1.  
  2. SCREEN 2,320,250,5,1
  3. WINDOW 2,"           RAUMGESTALTUNG",,0,2
  4.   PALETTE 29,0,0,0      
  5.   PALETTE 1,0.8,0,0     
  6.   PALETTE 2,1,0,0      
  7.   PALETTE 3,0.93,0.2,0   
  8.   PALETTE 4,1,0.4,0     
  9.   PALETTE 5,1,0.6,0     
  10.   PALETTE 6,1,0.8,0     
  11.   PALETTE 7,1,1,0     
  12.   PALETTE 8,0.6,1,0.15   
  13.   PALETTE 9,0.5,0.8,0.15  
  14.   PALETTE 10,0.4,0.6,0   
  15.   PALETTE 11,0.2,0.4,0   
  16.   PALETTE 12,0,0.4,0    
  17.   PALETTE 13,0,0.6,0.67  
  18.   PALETTE 14,0,0.8,0.6   
  19.   PALETTE 15,0,1,0.6   
  20.   PALETTE 16,0.2,1,0.93  
  21.   PALETTE 17,0.2,0.75,1  
  22.   PALETTE 18,0.15,0.4,1  
  23.   PALETTE 19,0.4,0,1    
  24.   PALETTE 20,0,0,0.6    
  25.   PALETTE 21,0.35,0.15,0.8
  26.   PALETTE 22,0.6,0.2,1   
  27.   PALETTE 23,1,0,1     
  28.   PALETTE 24,0.9,0.5,0.75 
  29.   PALETTE 25,1,0.75,0.75 
  30.   PALETTE 26,0.8,0.55,0.5 
  31.   PALETTE 27,0.6,0.4,0.35 
  32.   PALETTE 28,0.4,0.2,0   
  33.   PALETTE 0,0.6,0.6,0.6  
  34.   PALETTE 30,0.6,0.6,0.6   
  35.   PALETTE 31,0.7,0.7,0.7    
  36.    CLEAR ,20000                
  37.    DIM bau(110,20)  
  38.    w=1:mx=-1:my=0
  39.    FOR ein=1 TO 20
  40. ON ein GOSUB radier,fenstero,fensteru,fensterl,fensterr,kreuz,vierb,tisch,stuhlk,kasten,balkeno,balkenu,links,rechts,stuhl,eckelu,eckero,eckeol,eckeur,tischgr
  41.    GET(0,0)-(19,19),bau(110,ein-1)
  42.    CLS               
  43.    NEXT
  44.    GOSUB Rahmen : GOSUB bauen   
  45. retur:
  46.    MENU ON
  47.    WHILE MOUSE(0) = 0
  48.    x = MOUSE(1): y = MOUSE(2)
  49.    IF y<180 THEN
  50.    PUT(x-10,y-5),bau(110,w)
  51.    PUT(x-10,y-5),bau(110,w)
  52.    END IF
  53.    WEND       
  54.    IF x> = 300 THEN retur                
  55.    IF y> = 180 THEN GOTO taste
  56. kleber:                             
  57.    x = FIX (x/20): y = FIX(y/20)
  58.    x = x*20: y = y*20
  59.    IF w = 19 AND mx<>-1 THEN PUT(mx,my),bau(110,19)
  60.    IF x = mx AND y = my THEN mx = -1
  61.    IF w<19 THEN PUT(x,y),bau(110,w),PSET :ELSE PUT(x,y),bau(110,19)
  62.    mx = x: my = y
  63.    GOTO retur 
  64. taste:                           
  65.    rx = MOUSE(1)
  66.    rx = FIX(rx/20): y = FIX(y/20): y = y*20
  67.    IF y = 180 THEN w = rx
  68.    IF y = 200 AND rx<5 THEN w = 15+rx 
  69.    IF y = 200 AND rx> = 5 THEN druecke
  70.    a = MOUSE(0) 
  71.    GOTO retur
  72. '**************************
  73. druecke:
  74.     rx = MOUSE(1)
  75.     IF rx <160 AND rx >120 THEN sauber
  76.     IF rx <220 AND rx >180 THEN GOSUB screenDump
  77.     IF rx <280 AND rx >240 THEN GOTO ende    
  78. sauber:
  79.     LINE (20,20)-(280,178),0,bf
  80.     GOTO retur
  81. bauen:
  82.   FOR a = 0 TO 14 
  83.   x = a*20
  84.   PUT (x,182), bau(110,a),PSET
  85.   NEXT
  86.   FOR a = 15 TO 19
  87.   x =  a*20-300
  88.   PUT (x,202), bau(110,a),PSET
  89.   NEXT
  90.       CIRCLE (140,220),20,16,,,0.5:PAINT(140,220),16
  91.       CALL tool (125,220):COLOR 7,16:LOCATE 28,17:PRINT "NEU"
  92.       CIRCLE (204,220),22,16,,,0.5 :PAINT(200,220),16
  93.       CALL tool (185,220):COLOR 7,16:LOCATE 28,24:PRINT "DRUCK"
  94.       CIRCLE (270,220),22,16,,,0.5:PAINT (270,220),16
  95.       CALL tool (265,220):COLOR 7,16:LOCATE 28,33:PRINT "ENDE"
  96.   RETURN 
  97. Rahmen:
  98.    l=1:h=1
  99.    COLOR 20,0
  100.    LOCATE 3,5:PRINT "Geben Sie bitte ein"
  101.    LOCATE 6,5:PRINT "Raummindestmasse 10 * 8 m"
  102.    LOCATE 9,12:  INPUT"Länge   ";l            ' Länge
  103.    LOCATE 12,12:  INPUT"Breite  ";h           ' Breite
  104.    CLS
  105.    IF l< 11 THEN a = 282
  106.    IF h<  9 THEN b = 180
  107.    LINE(18,18)-(a,b),21,b             
  108.    LINE(19,19)-(a-1,b-1),21,b   
  109.    e=18 :f=18
  110.    FOR x = 18 TO a STEP (a-18)/l         
  111.    LINE (x,e-5) - (x,e+1),2
  112.    NEXT x   
  113.    FOR y = 18 TO b STEP (b-18)/h         
  114.    LINE (f-5,y) - (f+1,y),2
  115.    NEXT y
  116.    COLOR 20,0:LOCATE 2,35:PRINT l 
  117.    COLOR 20,0:LOCATE 22,1:PRINT h
  118.    LINE(18,18)-(a,b),21,b 
  119.    LINE(19,19)-(a-1,b-1),21,b 
  120.    SUB tool(c%,d%) STATIC
  121.    xa&=WINDOW(8)+36:ya&=WINDOW(8)+38
  122.    POKEW xa&,c%
  123.    POKEW ya&,d%
  124.    END SUB
  125.  
  126. radier:
  127.    LINE (0,0)-(20,20),0,bf
  128.    RETURN
  129.  
  130. fenstero:
  131.    LINE (0,10)-(19,19),11,b
  132.    LINE (0,10)-(19,19),11
  133.    LINE (0,19)-(19,10),11
  134.    RETURN
  135.  
  136. fensteru:
  137.    LINE (0,0)-(19,10),11,b
  138.    LINE (0,0)-(19,10),11
  139.    LINE (0,10)-(19,0),11
  140.    RETURN
  141. fensterl:
  142.    LINE (0,0)-(10,19),11,b
  143.    LINE (0,0)-(10,19),11
  144.    LINE (10,0)-(0,19),11
  145.    RETURN
  146.  
  147. kreuz:
  148.    LINE (0,0)-(19,19),11,b
  149.    LINE (0,0)-(19,19),11
  150.    LINE (0,19)-(19,0),11
  151.    RETURN
  152.  
  153. stuhl:
  154.   CIRCLE (10,10),6,21,,,1
  155.   PAINT (10,10),21 
  156.   RETURN
  157.  
  158. vierb:
  159.   LINE (0,0)-(19,3),19,bf
  160.   LINE (0,0)-(3,19),19,bf
  161.   LINE (16,0)-(19,16),19,bf
  162.   LINE (0,16)-(19,19),19,bf
  163.   RETURN
  164.  
  165. tisch:
  166.   LINE (0,0)-(19,19),20,bf
  167.   RETURN
  168.  
  169. fensterr:
  170.   LINE (10,0)-(19,19),11,b
  171.   LINE (10,0)-(19,19),11
  172.   LINE (10,19)-(19,0),11
  173.   RETURN
  174.  
  175. rechts:
  176.   LINE (10,0)-(19,19),28,bf
  177.   RETURN
  178.  
  179. links:
  180.   LINE (0,0)-(10,19),28,bf
  181.   RETURN
  182.  
  183. balkenu:
  184.   LINE (0,10)-(19,19),28,bf
  185.   RETURN
  186.  
  187. balkeno:
  188.   LINE (0,0)-(19,10),28,bf
  189.   RETURN
  190.  
  191. kasten:
  192.   LINE (10,1)-(1,10),18
  193.   LINE -(10,19),18
  194.   LINE -(19,10),18
  195.   LINE -(10,1),18
  196.   PAINT (10,14),18
  197.   RETURN
  198.  
  199. eckelu:
  200.    LINE (0,0)-(10,19),11,b
  201.    LINE (10,10)-(19,19),11,b
  202.    LINE (10,11)-(10,18),0
  203.    RETURN
  204.  
  205. eckero:
  206. LINE (0,0)-(19,10),11,b
  207. LINE (10,10)-(19,19),11,b
  208. LINE (11,10)-(18,10),0
  209. RETURN
  210.  
  211. eckeur:
  212. LINE (0,10)-(19,19),11,b
  213. LINE (10,0)-(19,10),11,b
  214. LINE (11,10)-(18,10),0
  215. RETURN
  216.  
  217. eckeol:
  218. LINE (0,0)-(19,10),11,b
  219. LINE (0,0)-(10,19),11,b
  220. LINE (10,1)-(10,9),0
  221. LINE (1,10)-(9,10),0
  222. RETURN
  223.  
  224. stuhlk:
  225. LINE (5,5)-(15,15),3,bf
  226. RETURN
  227.  
  228. tischgr:
  229. CIRCLE (10,10),8,0,,,1:PAINT(10,10),0
  230. RETURN
  231.  
  232. screenDump:
  233. LINE (0,180)-(300,248),0,bf
  234.  
  235. IF AlreadyDeclared = 0 THEN
  236.  DECLARE FUNCTION AllocSignal%() LIBRARY
  237.  DECLARE FUNCTION AllocMem&()    LIBRARY
  238.  DECLARE FUNCTION FindTask&()    LIBRARY
  239.  DECLARE FUNCTION DoIO&()        LIBRARY
  240.  DECLARE FUNCTION OpenDevice&    LIBRARY
  241.  AlreadyDeclared = 1
  242. END IF
  243.  
  244. sWindow&   = WINDOW(7)
  245. sScreen&   = PEEKL(sWindow& + 46)
  246. sViewPort& = sScreen& + 44
  247. sRastPort& = sScreen& + 84
  248. sColorMap& = PEEKL(sViewPort& + 4)
  249.  
  250.  
  251. maxWidth%  = PEEKW(sScreen& + 12)
  252. maxHeight% = PEEKW(sScreen& + 14)        
  253. viewModes% = PEEKW(sViewPort& + 32)
  254.  
  255. command%  = 11   'Drucker-Befehls-Nummer
  256. srcX% = 0        'Sende ganzen Screen
  257. srcY% = 0 
  258. srcWidth%  = maxWidth%
  259. srcHeight% = maxHeight%
  260. destRows& = 0    
  261. destCols& = 0
  262. special% = &H84  'FullCol | Aspect
  263.  
  264. IF BorderFlag% = 0 THEN  'Kein Rahmen
  265.    srcX% = srcX% + 3
  266.    srcY% = srcY% + 11
  267.    srcWidth%  = srcWidth% - 3 - 11
  268.    srcHeight% = srcHeight% - 11 - 3
  269. END IF   
  270.  
  271. LIBRARY "exec.library"
  272.  
  273.  
  274. sigBit% =  AllocSignal%(-1)
  275. ClearPublic& = 65537
  276. msgPort& = AllocMem&(40,ClearPublic&)
  277. IF msgPort& = 0 THEN
  278.    PRINT "msgPort nicht allokierbar."
  279.    GOTO cleanup4
  280. END IF
  281.  
  282.  
  283. POKE(msgPort& + 8), 4 'Type=NT_MSGPORT
  284. POKE(msgPort& + 9), 0 'Priority 0 
  285. portName$ = "MyPrtPort"+CHR$(0)
  286. POKEL(msgPort& + 10), SADD(portName$)
  287. POKE(msgPort& + 14), 0 'Flags
  288. POKE(msgPort& + 15), sigBit%
  289. sigTask& = FindTask&(0)
  290. POKEL(msgPort& + 16), sigTask&
  291.  
  292. CALL AddPort(msgPort&)  'Port hinzufuegen
  293.  
  294.  
  295. ioRequest& = AllocMem&(64,ClearPublic&)
  296. IF ioRequest& = 0  THEN
  297.    PRINT "ioRequest nicht allokierbar."
  298.    GOTO cleanup3
  299. END IF
  300.  
  301. POKE(ioRequest& + 8),5 'Type=NT_MESSAGE
  302. POKE(ioRequest& + 9),0 'Priority 0
  303. POKEL(ioRequest& + 14), msgPort&
  304.  
  305.  
  306. devName$ = "printer.device"+CHR$(0)
  307. pError& = OpenDevice&(SADD(devName$),0,ioRequest&,0)
  308. IF pError& <> 0  THEN
  309.    PRINT "Drucker nicht ansprechbar."
  310.    GOTO cleanup2
  311. END IF
  312.  
  313.  
  314. POKEW(ioRequest& + 28), command%
  315. POKEL(ioRequest& + 32), sRastPort&
  316. POKEL(ioRequest& + 36), sColorMap&
  317. POKEL(ioRequest& + 40), viewModes%
  318. POKEW(ioRequest& + 44), srcX%
  319. POKEW(ioRequest& + 46), srcY%
  320. POKEW(ioRequest& + 48), srcWidth%
  321. POKEW(ioRequest& + 50), srcHeight%
  322. POKEL(ioRequest& + 52), destCols&
  323. POKEL(ioRequest& + 56), destRows&
  324. POKEW(ioRequest& + 60), special%
  325.  
  326. ioError& = DoIO&(ioRequest&)
  327. IF ioError& <> 0 THEN
  328.    PRINT "DumpRPort Fehler =" ioError&
  329.    GOTO cleanup1
  330. END IF
  331.  
  332. cleanup1:
  333.    REM  *** Close Printer Device ***
  334.    CALL CloseDevice(ioRequest&)
  335.  
  336. cleanup2:
  337.    REM  *** DeleteExtIO ***
  338.    POKE(ioRequest& + 8), &Hff
  339.    POKEL(ioRequest& + 20), -1
  340.    POKEL(ioRequest& + 24), -1
  341.    CALL FreeMem(ioRequest&,64)
  342.  
  343. cleanup3:
  344.    REM  *** DeletePort ***
  345.    CALL RemPort(msgPort&)
  346.    POKE(msgPort& + 8), &Hff  
  347.    POKEL(msgPort& + 20), -1
  348.    CALL FreeSignal(sigBit%)
  349.    CALL FreeMem(msgPort&,40)
  350.    
  351. cleanup4:
  352.    
  353.    LIBRARY CLOSE  
  354. END      
  355. ende:
  356. WINDOW CLOSE 2:SCREEN CLOSE 2
  357. SYSTEM   
  358. END
  359.  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  360.  '
  361.  'Detlef Kornatz
  362.  'Feuerbachstrasse 6
  363.  'D-4300 ESSEN 1
  364.  '
  365.  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  366.